home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
UCB Logo 3.0
/
CSLS
/
fsm
< prev
next >
Wrap
Text File
|
1993-08-05
|
7KB
|
313 lines
TO ACCEPT
LOCAL "OLDPOS
MAKE "OLDPOS CURSOR
SETCURSOR [15 1]
TYPE "ACCEPT
SETCURSOR :OLDPOS
END
TO ACCEPTPART :MACHINE
OP LAST :MACHINE
END
TO ARRANGE :MOVE
LOCAL [FROM INPUT TO ARROW]
MAKE "FROM FIRST :MOVE
MAKE "INPUT FIRST BF :MOVE
MAKE "TO LAST :MOVE
MAKESTATE :FROM
MAKESTATE :TO
MAKE "ARROW WORD :FROM :INPUT
IFELSE NAMEP :ARROW [ARRANGE.DUPLICATE :ARROW] [ARRANGE.UNSEEN :ARROW]
END
TO ARRANGE.DUPLICATE :ARROW
IF MEMBERP :TO THING :ARROW [STOP]
MAKE "TROUBLE "TRUE
MAKE :ARROW MERGE :TO THING :ARROW
END
TO ARRANGE.UNSEEN :ARROW
MAKE :FROM FPUT :INPUT THING :FROM
TEMPMAKE :ARROW SINGLE :TO
END
TO BLANK
LOCAL "OLDPOS
MAKE "OLDPOS CURSOR
SETCURSOR [15 1]
TYPE "| |
SETCURSOR :OLDPOS
END
TO BUILD.STATE :STATE
OP MAP [LINK :STATE ? (FIRST THING WORD :STATE ?)] THING :STATE
END
TO DETERMINE :MACHINE
LOCAL [NEWACCEPT ALLSTATES ALIASES TROUBLE TEMPNAMES NEWMOVES]
MAKE "NEWACCEPT ACCEPTPART :MACHINE
MAKE "ALLSTATES []
MAKE "ALIASES []
MAKE "TROUBLE "FALSE
MAKE "TEMPNAMES []
FOREACH MOVEPART :MACHINE [ARRANGE ?]
IF NOT :TROUBLE [FOREACH :TEMPNAMES [ERN ?] OP :MACHINE]
RESOLVE :ALLSTATES
MAKE "NEWMOVES REBUILD :ALLSTATES
FOREACH :TEMPNAMES [ERN ?]
OP LINK (STARTPART :MACHINE) :NEWMOVES :NEWACCEPT
END
TO FSM :MACHINE
CT
SETCURSOR [0 3]
FSM1 FIRST :MACHINE FIRST :MACHINE FIRST BF :MACHINE LAST :MACHINE
END
TO FSM1 :START :HERE :MOVES :ACCEPT
IFELSE MEMBERP :HERE :ACCEPT [ACCEPT] [REJECT]
FSM1 :START (FSMNEXT :START :HERE RC :MOVES) :MOVES :ACCEPT
END
TO FSMNEXT :START :HERE :INPUT :MOVES
BLANK
TYPE :INPUT
IF EQUALP :INPUT CHAR 13 [TYPE CHAR 10 OP :START]
IF EQUALP :INPUT CHAR 10 [OP :START]
CATCH "ERROR [OP LAST FIND [FSMTEST :HERE :INPUT ?] :MOVES]
OP -1
END
TO FSMTEST :HERE :INPUT :MOVE
OP AND (EQUALP :HERE FIRST :MOVE) (EQUALP :INPUT FIRST BF :MOVE)
END
TO GAME :WHICH
FSM THING WORD "MACH :WHICH
END
TO GETALIAS :LIST
CATCH "ERROR [OP FIRST FIND [EQUALP :LIST LAST ?] :ALIASES]
OP []
END
TO LINK :ONE :TWO :THREE
OP (LIST :ONE :TWO :THREE)
END
TO MACHINE :REGEXP
LOCAL "NEXTSTATE
MAKE "NEXTSTATE 0
OP OPTIMIZE DETERMINE NONDET :REGEXP
END
TO MAKESTATE :STATE
IF MEMBERP :STATE :ALLSTATES [STOP]
MAKE "ALLSTATES FPUT :STATE :ALLSTATES
TEMPMAKE :STATE []
END
TO MANY.MOVES :PARTMOVE :ACCEPT
FOREACH :ACCEPT [NEWMOVES SINGLE FPUT ? :PARTMOVE]
END
TO MAPND :EXPRS
OP MAP [NONDET ?] :EXPRS
END
TO MERGE :NEW :LIST
IF EMPTYP :LIST [OP FPUT :NEW []]
IF :NEW < FIRST :LIST [OP FPUT :NEW :LIST]
OP FPUT FIRST :LIST MERGE :NEW BF :LIST
END
TO MOVEPART :MACHINE
OP FIRST BF :MACHINE
END
TO NDCONCAT :EXPRS
OP REDUCE "STRING MAPND :EXPRS
END
TO NDLETTER :LETTER
LOCAL [FROM TO]
MAKE "FROM NEWSTATE
MAKE "TO NEWSTATE
OP LINK :FROM (SINGLE (LINK :FROM :LETTER :TO)) (SINGLE :TO)
END
TO NDMANY :REGEXP
OP NDMANY1 NONDET :REGEXP
END
TO NDMANY1 :MACHINE
LOCAL [START MOVES ACCEPT]
MAKE "START STARTPART :MACHINE
MAKE "MOVES MOVEPART :MACHINE
MAKE "ACCEPT ACCEPTPART :MACHINE
FOREACH :MOVES [IF EQUALP :START FIRST ? [MANY.MOVES BF ? :ACCEPT]]
OP LINK :START :MOVES (FPUT :START :ACCEPT)
END
TO NDOR :EXPRS
OP UNION NEWSTATE MAPND :EXPRS
END
TO NEWACCEPT :NEW
IF NOT MEMBERP :NEW :ACCEPT [MAKE "ACCEPT SE :NEW :ACCEPT]
END
TO NEWMOVES :NEW
MAKE "MOVES SE :NEW :MOVES
END
TO NEWSTATE
MAKE "NEXTSTATE :NEXTSTATE+1
OP :NEXTSTATE
END
TO NONDET :REGEXP
IF WORDP :REGEXP [OP NDLETTER :REGEXP]
IF EQUALP FIRST :REGEXP "OR [OP NDOR BF :REGEXP]
IF EQUALP FIRST :REGEXP "* [OP NDMANY LAST :REGEXP]
OP NDCONCAT :REGEXP
END
TO OPTIMIZE :MACHINE
LOCAL [START MOVES ACCEPT GOODSTATES GOODMOVES OLDMOVES]
MAKE "START STARTPART :MACHINE
MAKE "MOVES MOVEPART :MACHINE
MAKE "ACCEPT ACCEPTPART :MACHINE
MAKE "GOODSTATES SINGLE STARTPART :MACHINE
MAKE "GOODMOVES []
DO.UNTIL [MAKE "OLDMOVES :GOODMOVES ~
MAKE "MOVES FILTER [OPTIMIZE2 ?] :MOVES] ~
[EQUALP :OLDMOVES :GOODMOVES]
OP LINK :START :GOODMOVES (FILTER [MEMBERP ? :GOODSTATES] :ACCEPT)
END
TO OPTIMIZE2 :MOVE
IF NOT MEMBERP FIRST :MOVE :GOODSTATES [OP "TRUE]
MAKE "GOODMOVES FPUT :MOVE :GOODMOVES
IF NOT MEMBERP LAST :MOVE :GOODSTATES ~
[MAKE "GOODSTATES FPUT LAST :MOVE :GOODSTATES]
OP "FALSE
END
TO REBUILD :STATELIST
OP MAP.SE [BUILD.STATE ?] :STATELIST
END
TO REJECT
LOCAL "OLDPOS
MAKE "OLDPOS CURSOR
SETCURSOR [15 1]
TYPE "REJECT
SETCURSOR :OLDPOS
END
TO RESOLVE :STATES
IF EMPTYP :STATES [STOP]
LOCAL "STATE
MAKE "STATE FIRST :STATES
RESOLVE SE (BF :STATES) ~
(MAP.SE [RESOLVE.ARROW WORD :STATE ?] THING :STATE)
END
TO RESOLVE.ARROW :ARROW
LOCAL [DESTINATIONS ALIAS]
MAKE "DESTINATIONS THING :ARROW
IF EMPTYP BF :DESTINATIONS [OP []]
MAKE "ALIAS GETALIAS :DESTINATIONS
IF NOT EMPTYP :ALIAS [MAKE :ARROW SINGLE :ALIAS OP []]
MAKE "ALIAS NEWSTATE
MAKESTATE :ALIAS
MAKE :ARROW SINGLE :ALIAS
MAKE "ALIASES FPUT (LIST :ALIAS :DESTINATIONS) :ALIASES
FOREACH :DESTINATIONS [SETUPALIAS ?]
OP :ALIAS
END
TO SETA.INPUT :STATE :INPUT
FOREACH (THING WORD :STATE :INPUT) [ARRANGE LINK :ALIAS :INPUT ?]
END
TO SETUPALIAS :STATE
IF AND (MEMBERP :STATE :NEWACCEPT) (NOT MEMBERP :ALIAS :NEWACCEPT) ~
[MAKE "NEWACCEPT FPUT :ALIAS :NEWACCEPT]
FOREACH THING :STATE [SETA.INPUT :STATE ?]
END
TO SINGLE :THING
OP (LIST :THING)
END
TO STARTPART :MACHINE
OP FIRST :MACHINE
END
TO STRING :MACHINE :OTHERS
LOCAL [START MOVES ACCEPT OTHERSTART OTHERMOVES OTHERACCEPT]
MAKE "START STARTPART :MACHINE
MAKE "MOVES MOVEPART :MACHINE
MAKE "ACCEPT ACCEPTPART :MACHINE
MAKE "OTHERSTART STARTPART :OTHERS
MAKE "OTHERMOVES MOVEPART :OTHERS
MAKE "OTHERACCEPT ACCEPTPART :OTHERS
OP LINK :START ~
(SE :MOVES ~
(STRING.SPLICE :ACCEPT :OTHERSTART :OTHERMOVES) ~
:OTHERMOVES) ~
(STRINGA :ACCEPT :OTHERSTART :OTHERACCEPT)
END
TO STRING.COPY :ACCEPT :OTHERSTART :MOVE
OP IFELSE EQUALP :OTHERSTART FIRST :MOVE [MAP [FPUT ? BF :MOVE] :ACCEPT] [[]]
END
TO STRING.SPLICE :ACCEPT :OTHERSTART :OTHERMOVES
OP MAP.SE [STRING.COPY :ACCEPT :OTHERSTART ?] :OTHERMOVES
END
TO STRINGA :ACCEPT :OTHERSTART :OTHERACCEPT
IF MEMBERP :OTHERSTART :OTHERACCEPT [OP SE :ACCEPT :OTHERACCEPT]
OP :OTHERACCEPT
END
TO TEMPMAKE :VAR :VAL
MAKE "TEMPNAMES FPUT :VAR :TEMPNAMES
MAKE :VAR :VAL
END
TO UNION :START :MACHINES
LOCAL [MOVES ACCEPT]
MAKE "MOVES []
MAKE "ACCEPT []
FOREACH :MACHINES [UNION1 ?]
OUTPUT LINK :START :MOVES :ACCEPT
END
TO UNION1 :MACHINE
NEWMOVES MOVEPART :MACHINE
NEWMOVES MAP [FPUT :START BF ?] ~
FILTER [EQUALP (STARTPART :MACHINE) (FIRST ?)] MOVEPART :MACHINE
NEWACCEPT ACCEPTPART :MACHINE
IF MEMBERP (STARTPART :MACHINE) (ACCEPTPART :MACHINE) ~
[NEWACCEPT :START]
END
MAKE "MACH1 [1 [[1 A 1] [1 B 1]] [1]]
MAKE "MACH10 [1 [[1 A 1] [1 B 1] [1 C 2] [2 A 3] [2 B 1] [3 A 1]] [1]]
MAKE "MACH2 [1 [[1 A 2] [1 B 2] [1 C 2] [2 A 1] [2 B 1] [2 C 1]] [1]]
MAKE "MACH3 [1 [[1 A 2] [2 B 3] [3 A 3] [3 B 3] [3 C 3]] [3]]
MAKE "MACH4 [1 [[1 A 2] [1 B 3] [1 C 4] [2 A 1] [3 B 1] [4 C 1]] [1]]
MAKE "MACH5 [1 [[1 A 2] [1 B 2] [1 C 2] [2 B 1]] [1]]
MAKE "MACH6 [1 [[1 A 2] [2 A 2] [2 B 2] [2 C 3] [3 A 2] [3 B 2] [3 C 3]] [3]]
MAKE "MACH7 [1 [[1 A 1] [1 B 1] [1 C 2] [2 C 1]] [1]]
MAKE "MACH8 [1 [[1 A 2] [1 B 1] [1 C 1] [2 A 1] [2 B 2] [2 C 2]] [1]]
MAKE "MACH9 [1 [[1 A 2] [1 B 1] [1 C 1] [2 A 2] [2 B 3] [2 C 1] [3 A 2] ~
[3 B 1] [3 C 4] [4 A 2] [4 B 5] [4 C 1] [5 A 6] [5 B 1] ~
[5 C 1] [6 A 6] [6 B 6] [6 C 6]] ~
[6]]